perm filename FRED.PR[E81,JMC] blob
sn#602246 filedate 1981-07-24 generic text, type T, neo UTF8
nott(P) :- P, !, fail.
nott(←).
assoc(X,[],[]).
assoc(X,[[X|Y]|L],[X|Y]) :- !.
assoc(X,[[X1|Y]|L],W) :- X\==X1,assoc(X,L,W).
colored(X,U,[[X|W]|C]) :- iscolor(W),!,W=U.
colored(X,U,[[Y|W]|C]) :- colored(X,U,C).
iscolor(y).
iscolor(b).
iscolor(r).
iscolor(g).
ok([],[]).
ok([[X|U]|C],[[X|L]|M]) :- compatible(X,U,L,C) , ok(C,M).
compatible(X,U,[],C).
compatible(X,U,[Y|L],C) :- colored(Y,V,C),n(U,V),compatible(X,U,L,C).
n(U,V) :- U \== V.
color(M,L,C) :- removable(M,L,X),!,color(M,[X|L],C).
color(M,L,C) :- color1([M|L],M1),fillin([M|L],M1,C).
color1(X,[]).
removable([[X|U]|M],L,X) :- nott(member(X,L)), lthree(U,L).
removable([[Y|U]|M],L,X) :- Y \== X,removable(M,L,X).
lthree([],L).
lthree([X|U],L) :- member(X,L),lthree(U,L).
lthree([X|U],L) :- ltwo(U,L).
ltwo([],L).
ltwo([X|U],L) :- member(X,L),ltwo(U,L).
ltwo([X|U],L) :- lone(U,L).
lone([],L).
lone([X|U],L) :- member(X,L),lone(U,L).
lone([X],L).
member(H,[H|←]) :- !.
member(I,[←|T]) :- member(I,T).
member1(H,[H|←]).
member1(I,[←|T]) :- member1(I,T).
fillin([M|[]],C,C).
fillin([M|[X|L]],C,W) :- assoc(X,M,[X|U]),
iscolor(Z),
nott(conflicts(U,C,Z)),
fillin([M|L],[[X|Z]|C],W).
conflicts(U,C,Z) :- member1(Y,U),assoc(Y,C,[Y|Z]).
cp(X) :- color([[r1,r2,r3,r5,r6],[r2,r1,r3,r4,r5,r6],[r3,r1,r2,r4,r6],
[r4,r2,r3],[r5,r1,r2,r6],[r6,r1,r2,r3,r5]],[],X).